home *** CD-ROM | disk | FTP | other *** search
/ PC Answers 1995 May / PC Answers CD-ROM 7 (Future Publishing) (May 1995).iso / vbits / code / zuck / screenca.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1994-10-06  |  4.0 KB  |  120 lines
  1. VERSION 2.00
  2. Begin Form ScreenCap 
  3.    Caption         =   "Screen Capture"
  4.    ClientHeight    =   3225
  5.    ClientLeft      =   1095
  6.    ClientTop       =   1485
  7.    ClientWidth     =   5430
  8.    Height          =   3630
  9.    Left            =   1035
  10.    LinkTopic       =   "Form2"
  11.    ScaleHeight     =   3225
  12.    ScaleWidth      =   5430
  13.    Top             =   1140
  14.    Width           =   5550
  15.    Begin CommandButton Command2 
  16.       Caption         =   "Start"
  17.       Height          =   555
  18.       Left            =   4140
  19.       TabIndex        =   2
  20.       Top             =   1620
  21.       Width           =   1155
  22.    End
  23.    Begin CommandButton Command1 
  24.       Caption         =   "Ok"
  25.       Height          =   555
  26.       Left            =   4140
  27.       TabIndex        =   1
  28.       Top             =   2340
  29.       Width           =   1155
  30.    End
  31.    Begin PictureBox Picture1 
  32.       AutoRedraw      =   -1  'True
  33.       Height          =   2955
  34.       Left            =   180
  35.       ScaleHeight     =   195
  36.       ScaleMode       =   3  'Pixel
  37.       ScaleWidth      =   251
  38.       TabIndex        =   0
  39.       Top             =   180
  40.       Width           =   3795
  41.    End
  42. Option Explicit
  43. Dim HasCapture%
  44. Dim StartPoint As POINTAPI
  45. Dim EndPoint As POINTAPI
  46. Dim DashedPen%
  47. Sub Command1_Click ()
  48.     Unload Me
  49. End Sub
  50. Sub Command2_Click ()
  51.     Dim di%
  52.     Me.WindowState = 1
  53.     di% = SetCapture(picture1.hWnd)
  54. End Sub
  55. Sub DrawScreenBox (pic As PictureBox, ByVal x1%, ByVal y1%, ByVal x2%, ByVal y2%, copyit%)
  56.     Dim scrhwnd%, usedc%, di%, oldrop%, oldpen%
  57.     Dim picpt1 As POINTAPI, picpt2 As POINTAPI
  58.     Dim usewidth%, useheight%
  59.     scrhwnd% = GetDeskTopWindow()
  60.     usedc% = CreateDC("Display", ByVal 0&, ByVal 0&, ByVal 0&)
  61.     oldrop% = SetROP2(usedc%, R2_XORPEN)
  62.     oldpen% = SelectObject(usedc%, DashedPen%)
  63.     di% = SelectObject(usedc%, GetStockObject(NULL_BRUSH))
  64.     ' Change to screen coordinates
  65.     picpt1.x = x1%: picpt1.y = y1%
  66.     picpt2.x = x2%: picpt2.y = y2%
  67.     ClientToScreen picture1.hWnd, picpt1
  68.     ClientToScreen picture1.hWnd, picpt2
  69.     di% = Rectangle(usedc%, picpt1.x, picpt1.y, picpt2.x, picpt2.y)
  70.     usewidth% = picpt2.x - picpt1.x
  71.     If picture1.ScaleWidth < usewidth% Then usewidth% = picture1.ScaleWidth
  72.     useheight% = picpt2.y - picpt1.y
  73.     If picture1.ScaleHeight < useheight% Then useheight% = picture1.ScaleHeight
  74.     picture1.Cls
  75.     di% = BitBlt(picture1.hDC, 0, 0, picpt2.x - picpt1.x, picpt2.y - picpt1.y, usedc%, picpt1.x, picpt1.y, SRCCOPY)
  76.     di% = DeleteDC(usedc%)
  77. End Sub
  78. Sub Form_Load ()
  79.     DashedPen% = CreatePen(PS_DOT, 1, 0)
  80. End Sub
  81. Sub Form_Resize ()
  82.     If WindowState <> 0 Then Exit Sub
  83.     picture1.Move 0, 0, Me.ScaleWidth - Command1.Width * 1.2, Me.ScaleHeight
  84. End Sub
  85. Sub Form_Unload (Cancel As Integer)
  86.     Dim di%
  87.     If DashedPen% <> 0 Then
  88.         di% = DeleteObject(DashedPen%)
  89.     End If
  90. End Sub
  91. Sub Picture1_MouseDown (Button As Integer, Shift As Integer, x As Single, y As Single)
  92.     ' This conversion is safe, as we are in pixels
  93.     If ScreenCap.WindowState = 0 Then Exit Sub
  94.     StartPoint.x = CInt(x)
  95.     StartPoint.y = CInt(y)
  96.     EndPoint.x = CInt(x)
  97.     EndPoint.y = CInt(y)
  98.     HasCapture% = True
  99. End Sub
  100. Sub Picture1_MouseMove (Button As Integer, Shift As Integer, x As Single, y As Single)
  101.     If HasCapture% Then
  102.         DrawScreenBox picture1, StartPoint.x, StartPoint.y, EndPoint.x, EndPoint.y, False
  103.         DrawScreenBox picture1, StartPoint.x, StartPoint.y, x, y, False
  104.     End If
  105.     EndPoint.x = x
  106.     EndPoint.y = y
  107. End Sub
  108. Sub Picture1_MouseUp (Button As Integer, Shift As Integer, x As Single, y As Single)
  109.     ' If we're not mouse tracking, exit the subroutine
  110.     If Not HasCapture% Then Exit Sub
  111.     DrawScreenBox picture1, StartPoint.x, StartPoint.y, EndPoint.x, EndPoint.y, True
  112.     EndPoint.x = x
  113.     EndPoint.y = y
  114.     ' Blt it here
  115.     HasCapture% = 0
  116.     ' Restore the original drawing mode
  117.     ScreenCap.WindowState = 0
  118.     picture1.Refresh
  119. End Sub
  120.